home *** CD-ROM | disk | FTP | other *** search
-
- Unit XMSLib;
- { XMSLIB V2.02 Copyright (c) 1994 by Andrew Eigus Fido Net: 2:5100/33 }
- { XMS Interface for Turbo Pascal version 7.0 }
-
- (*
- XMS termines:
-
- XMS: eXtended Memory Specification
- XMS gives access to extended memory and noncontiguous/nonEMS
- memory above 640K
- UMB: Upper Memory Block
- HMA: High Memory Area
-
- Material used:
-
- C and ASM source of XMS Library (c) by Michael Graff,
- eXtended Memory Specification unit source (c) by Yuval Tal,
- Interrupt List V1.02 (WindowBook) (c) 1984-90 Box Company, Inc.
- *)
-
- interface
-
- const
-
- { XMS function numbers }
-
- XGetVersion = $00;
- XRequestHMA = $01;
- XReleaseHMA = $02;
- XGlobalE20 = $03;
- XGlobalD20 = $04;
- XLocalE20 = $05;
- XLocalD20 = $06;
- XQuery20 = $07;
- XGetMemSize = $08;
- XAllocEMB = $09;
- XFreeEMB = $0A;
- XMoveEMB = $0B;
- XLockEMB = $0C;
- XUnlockEMB = $0D;
- XGetHandleInfo = $0E;
- XReallocEMB = $0F;
- XRequestUMB = $10;
- XReleaseUMB = $11;
-
- { XMS_GetVersion parameters }
-
- XMS = True; { Get XMS version }
- XMM = False; { Get XMM version }
-
- { XMS functions return codes }
-
- xmsrOk = $00; { Function successful }
- xmsrNotInitd = $01; { XMS driver not initialized by XMS_Setup }
- xmsrBadFunction = $80; { Function not implemented }
- xmsrVDiskDetected = $81; { VDisk was detected }
- xmsrA20Error = $82; { An A20 error occurred }
- xmsrDriverError = $8E; { A general driver error }
- xmsrUnrecError = $8F; { Unrecoverable driver error }
- xmsrNoHMA = $90; { HMA does not exist }
- xmsrHMAInUse = $91; { HMA is already in use }
- xmsrHMAMinError = $92; { HMAMIN parameter is too large }
- xmsrHMANotAlloc = $93; { HMA is not allocated }
- xmsrA20Enabled = $94; { A20 line still enabled }
- xmsrNoMoreMem = $A0; { All extended memory is allocated }
- xmsrNoMoreHandles = $A1; { All available XMS handles are allocated }
- xmsrBadHandle = $A2; { Invalid handle }
- xmsrBadSourceH = $A3; { Source handle is invalid }
- xmsrBadSourceO = $A4; { Source offset is invalid }
- xmsrBadDestH = $A5; { Destination handle is invalid }
- xmsrBadDestO = $A6; { Destination offset is invalid }
- xmsrBadLength = $A7; { Length (size) is invalid }
- xmsrBadOverlap = $A8; { Move has an invalid overlap }
- xmsrParityError = $A9; { Parity error occurred }
- xmsrBlkNotLocked = $AA; { Block is not locked }
- xmsrBlkLocked = $AB; { Block is locked }
- xmsrBlkLCOverflow = $AC; { Block lock count overflowed }
- xmsrLockFailed = $AD; { Lock failed }
- xmsrSmallerUMB = $B0; { Only a smaller UMB is available }
- xmsrNoUMB = $B1; { No UMB's are available }
- xmsrBadUMBSegment = $B2; { UMB segment number is invalid }
-
- type
- THandle = Word; { Memory block handle type }
-
- var
- XMSResult : byte; { Returns the status of the last XMS operation performed }
-
-
- function XMS_Setup : boolean;
- { This function returns True is the extended memory manager device driver
- is installed in memory and active. True if installed, False if not
- installed. You should call this function first, before any other are
- called so it will setup memory manager for use with your program }
-
- function XMS_GetVersion(OfWhat : boolean) : word;
- { This function returns eighter the version of the extended memory
- specifications version, or the version of the extended memory manager
- device driver version, depends on what you're using as an OfWhat
- parameter (see XMS_GetVersion parameters in const section of the unit).
- The result's low byte is the major version number, and the high byte is
- the minor version number }
-
- function XMS_HMAAvail : boolean;
- { This function obtains the status of the high memory area (HMA).
- If the result is true, HMA exists. If the result is False no HMA exists }
-
- function XMS_AllocHMA(Size : word) : byte;
- { This function allocates high memory area (HMA). Size contains the the
- bytes which are needed. The maximum HMA allocation is 65520 bytes.
- The base address of the HMA is FFFF:0010h. If an application fails
- to release the HMA before it terminates, the HMA becomes unavailable
- to the other programs until the system is restarted. Function returns
- zero (xmsrOk) if the call was successful, or one of the xmsr-error codes
- if the call has failed }
-
- function XMS_FreeHMA : byte;
- { This function releases the high memory area (HMA) and returns zero if
- the call was successful, or one of the xmsr-error codes if the call has
- failed }
-
- function XMS_GlobalEnableA20 : byte;
- { This function enables the A20 line and should only be used by programs
- that have successfully allocated the HMA. The result is zero if the
- call was successful, otherwise, the result is one of the (xmsr)
- return values }
-
- function XMS_GlobalDisableA20 : byte;
- { This function disables the A20 line and should only be used by programs
- that do not own the HMA. The result is zero if the call was successful,
- otherwise, the result is one of the (xmsr) return values }
-
- function XMS_LocalEnableA20 : byte;
- { This function enables the A20 line and should only be used by programs
- that have successfully allocated the HMA. The result is zero if the call
- was successful, otherwise, the result is one of the (xmsr) return values }
-
- function XMS_LocalDisableA20 : byte;
- { This function disables the A20 line and should only be used by programs
- that do not own the HMA. The A20 line should be disabled before the program
- releases control of the system. The result is zero if the call was
- successful, otherwise, the result is one of the (xmsr) return values }
-
- function XMS_QueryA20 : boolean;
- { This function returns the status of the A20 address line. If the result is
- True then the A20 line is enabled. If False, it is disabled }
-
- function XMS_MemAvail : word;
- { This function returns the total free extended memory in kilo-bytes }
-
- function XMS_MaxAvail : word;
- { This function returns the largest free extended memory block in kilo-bytes }
-
- function XMS_AllocEMB(Size : word) : THandle;
- { This function allocates extended memory block (EMB). Size defines the size
- of the requested block in kilo-bytes. Function returns a handle number
- which is used by the other EMB commands to refer to this block. If the call
- to this function was unsuccessful, zero is returned instead of the handle
- number and (xmsr) error code is stored in XMSResult variable }
-
- function XMS_ReallocEMB(Handle : THandle; Size : word) : byte;
- { This function reallocates EMB. Handle is a handle number which was given
- by XMS_AllocEMB. Size defines a new size of the requested block in
- kilo-bytes. Function returns zero if the call was successful, or
- a (xmsr) error code if it failed }
-
- function XMS_FreeEMB(Handle : THandle) : byte;
- { This function releases allocated extended memory. Handle is a handle number
- which was given by XMS_AllocEMB. Note: If a program fails to release its
- extended memory before it terminates, the memory becomes unavailable to
- other programs until the system is restarted. Blocks may not be released
- while they are locked. Function returns zero if the call was successful, or
- a (xmsr) error code if the call has failed }
-
- function XMS_MoveFromEMB(Handle : THandle; var Dest; Count : longint) : byte;
- { This function moves data from the extended memory to the conventional
- memory. Handle is a handle number given by XMS_AllocEMB. Dest is a non-typed
- variable so any kind of data can be written there. Count is the number of
- bytes which should be moved. The state of the A20 line is preserved.
- Function returns zero if the call was successful, or a (xmsr) error code
- if the call has failed }
-
- function XMS_MoveToEMB(Handle : THandle; var Source; Count : longint) : byte;
- { This function moves data from the conventional memory to the extended
- memory. Handle is a handle number given by XMS_AllocEMB. Source is a
- non-typed variable so any kind of data can be written there. Count is
- the number of bytes which should be moved. The state of the A20 line is
- preserved. Function returns zero if the call was successful, or a
- (xmsr) error code if the call has failed }
-
- function XMS_LockEMB(Handle : THandle) : pointer;
- { This function locks a specified EMB. This function is intended for use by
- programs which enable the A20 line and access extended memory directly.
- Handle is a handle number given by XMS_AllocEMB. The result is a 32-bit
- linear address of the locked block or NIL if lock did not succeed. The
- result value is stored in XMSResult variable }
-
- function XMS_UnlockEMB(Handle : THandle) : byte;
- { This function unlocks previously locked blocks (by XMS_LockEMB). After
- the EMB is unlocked the 32-bit pointer returned by XMS_LockEMB becomes
- invalid and should not be used. Handle is a handle number given by
- XMS_AllocEMB. The result value is zero if the call was successful,
- otherwise it is one of the (xmsr) return codes }
-
- function XMS_EMBHandlesAvail(Handle : THandle) : byte;
- { This function returns the number of free handles which are available to
- your program. Handle is a handle number given by XMS_AllocEMB. The result
- value is stored in XMSResult variable }
-
- function XMS_EMBLockCount(Handle : THandle) : byte;
- { This function returns the lock count of a specified EMB. Handle is a handle
- number given by XMS_AllocEMB. If the function returns zero it means that
- the block is not locked. The result value is stored in XMSResult variable }
-
- function XMS_EMBSize(Handle : THandle) : word;
- { This function determines the size of a specified EMB. Handle is a handle
- number given by XMS_AllocEMB. The result is the size of the block in
- kilo-bytes. The result code is stored in XMSResult variable }
-
- function XMS_AllocUMB(Size : word) : longint;
- { This function allocates upper memory blocks (UMBs). Size is the size of
- the block in paragraphs.
- Function returns:
- - segment base of the allocated block in the low-order word
- - actual block size in paragraphs in the high-order word
- In case of an error the high-order word will be the size of the largest
- available block in paragraphs.
- The result code is stored in XMSResult variable }
-
- function XMS_FreeUMB(Segment : word) : byte;
- { This function releases the memory that was allocated by XMS_FreeUMB.
- Segment must contain the segment base of the block which must be
- released. The result value is zero if the call was successful, or
- one of the (xmsr) error codes, otherwise }
-
- function XMS_GetErrorMsg(ErrorCode : byte) : string;
- { This function translates the error code which is returned by all the
- XMS_ functions in the unit from a number to a string. The error code is
- written to the global variable XMSResult (byte). If XMSResult is equal
- to zero then no errors were encountered. For more information about
- the result codes, see (xmsr) constants in the unit's const section }
-
-
- implementation
-
- type
- TransferRec = record
- TransferSize : longint;
- SourceHandle : THandle;
- SourceOffset : longint;
- DestHandle : THandle;
- DestOffset : longint
- end;
-
- var
- XMSInitd : boolean;
- XMSDriver : procedure;
- TR : TransferRec; { Internal transfer EMB structure }
-
- Function XMS_Setup; assembler;
- Asm
- MOV [XMSInitd],False
- MOV AX,4300h { XMS Driver installation check }
- INT 2Fh
- CMP AL,80h
- JE @@1 { XMS found }
- MOV AL,False { else XMS manager not found }
- JMP @@2
- @@1:
- MOV AX,4310h { Get address of XMS driver }
- INT 2Fh
- MOV WORD [XMSDriver],BX { store offset }
- MOV WORD [XMSDriver+2],ES { store segment }
- INC [XMSInitd] { we have init'd our code }
- MOV AL,True
- @@2:
- End; { XMS_Setup }
-
- Function XMS_GetVersion; assembler;
- Asm
- MOV [XMSResult],xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGetVersion { Function to get version }
- CALL [XMSDriver] { Call the XMS driver }
- MOV [XMSResult],xmsrOk
- CMP OfWhat,XMS { XMS or XMM version? }
- JE @@1 { If XMS, it's already in AX }
- MOV AX,BX { If XMM, it's in BX, so move it to AX }
- @@1:
- End; { XMS_GetVersion }
-
- Function XMS_HMAAvail; assembler;
- Asm
- MOV [XMSResult],xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGetVersion { Function number }
- CALL [XMSDriver]
- MOV [XMSResult],xmsrOk
- MOV AL,DL { Store result value }
- @@1:
- End; { XMS_HMAAvail }
-
- Function XMS_AllocHMA; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV DX,Size { Ammount of HMA wanted }
- MOV AH,XRequestHMA { Function to allocate HMA }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL { No error }
- @@1:
- MOV AL,BL { Store result value }
- MOV [XMSResult],BL { Save error code }
- End; { XMS_AllocHMA }
-
- Function XMS_FreeHMA; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XReleaseHMA { Function to release HMA }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1 { If error then jump, else }
- XOR BL,BL { clear error code }
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL { Get return code in XMSResult }
- End; { XMS_FreeHMA }
-
- Function XMS_GlobalEnableA20; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGlobalE20 { Function code }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL { Return no error }
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL { Store result value }
- End; { XMS_GlobalEnableA20 }
-
- Function XMS_GlobalDisableA20; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGlobalD20 { Function code }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL { Return success }
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL { Store result value }
- End; { XMS_GlobalDisableA20 }
-
- Function XMS_LocalEnableA20; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XLocalE20 { Function code }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL { Return no error value }
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL { Store result value }
- End; { XMS_LocalEnableA20 }
-
- Function XMS_LocalDisableA20; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XLocalD20 { Function code }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL { Return no error }
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL { Save result }
- End; { XMS_LocalDisableA20 }
-
- Function XMS_QueryA20; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XQuery20 { Function code }
- CALL [XMSDriver] { Call the XMS driver; result in AL }
- @@1:
- MOV [XMSResult],BL { Store error code value }
- End; { XMS_QueryA20 }
-
- Function XMS_MemAvail; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGetMemSize { Function code }
- CALL [XMSDriver] { Call the XMS driver }
- MOV AX,DX { AX=Get XMS memory available in K-bytes }
- @@1:
- MOV [XMSResult],BL { Store result value }
- End; { XMS_MemAvail }
-
- Function XMS_MaxAvail; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGetMemSize { Function code }
- CALL [XMSDriver] { Call the XMS driver }
- { AX=Get XMS maximum memory block available in K-bytes }
- @@1:
- MOV [XMSResult],BL { Store result value }
- End; { XMS_MaxAvail }
-
- Function XMS_AllocEMB; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@2
- MOV AH,XAllocEMB { Function code }
- MOV DX,Size { Number of K-Bytes to allocate }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- MOV AX,DX { Store handle number in AX }
- XOR BL,BL { Set no error }
- JMP @@2
- @@1:
- XOR AX,AX { Return handle 0 if error }
- @@2:
- MOV [XMSResult],BL
- End; { XMS_AllocEMB }
-
- Function XMS_ReallocEMB; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XReallocEMB { Function code }
- MOV DX,Handle { Handle number }
- MOV BX,Size { New size wanted in K-Bytes }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL { There's no error }
- @@1:
- MOV AL,BL { Return result value }
- MOV [XMSResult],BL { Store error code }
- End; { XMS_ReallocEMB }
-
- Function XMS_FreeEMB; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XFreeEMB { Function code }
- MOV DX,Handle { Set handle number in DX }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL { No error }
- @@1:
- MOV AL,BL { Return result value }
- MOV [XMSResult],BL { Store error code }
- End; { XMS_FreeEMB }
-
- Function XMS_MoveFromEMB; assembler;
- Asm
- PUSH DS
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV CX,WORD PTR [Count]
- MOV TR.WORD PTR [TransferSize],CX
- MOV CX,WORD PTR [Count+2]
- MOV TR.WORD PTR [TransferSize+2],CX
- MOV CX,Handle
- MOV TR.SourceHandle,CX
- MOV WORD PTR [TR.SourceOffset],0
- MOV WORD PTR [TR.SourceOffset+2],0
- MOV TR.DestHandle,0
- LES SI,Dest
- MOV WORD PTR [TR.DestOffset],SI
- MOV WORD PTR [TR.DestOffset+2],ES
- MOV AH,XMoveEMB
- MOV DX,SEG TR
- MOV DS,DX
- MOV SI,OFFSET TR
- CALL [XMSDriver]
- OR AX,AX
- JZ @@1
- XOR BL,BL
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL
- POP DS
- End; { XMS_MoveFromEMB }
-
- Function XMS_MoveToEMB; assembler;
- Asm
- PUSH DS
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV CX,WORD PTR [Count]
- MOV TR.WORD PTR [TransferSize],CX
- MOV CX,WORD PTR [Count+2]
- MOV TR.WORD PTR [TransferSize+2],CX
- MOV TR.SourceHandle,0
- LES SI,Source
- MOV WORD PTR [TR.SourceOffset],SI
- MOV WORD PTR [TR.SourceOffset+2],ES
- MOV CX,Handle
- MOV TR.DestHandle,CX
- MOV WORD PTR [TR.DestOffset],0
- MOV WORD PTR [TR.DestOffset+2],0
- MOV AH,XMoveEMB
- MOV DX,SEG TR
- MOV DS,DX
- MOV SI,OFFSET TR
- CALL [XMSDriver]
- OR AX,AX
- JZ @@1
- XOR BL,BL
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL
- POP DS
- End; { XMS_MoveToEMB }
-
- Function XMS_LockEMB; assembler;
- Asm
- CMP [XMSInitd],True
- JNE @@1 { if not initialized, return the NIL pointer }
- MOV AH,XLockEMB { Function code }
- MOV DX,Handle { Handle in DX }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX { Was the call successful? }
- JNZ @@2 { Yep, so jump and return pointer }
- @@1:
- XOR AX,AX
- XOR DX,DX { Return NIL }
- MOV [XMSResult],xmsrLockFailed
- JMP @@3
- @@2:
- MOV AX,BX { Offset in AX, Segment in DX }
- MOV XMSResult,xmsrOk
- @@3:
- End; { XMS_LockEMB }
-
- Function XMS_UnlockEMB; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XUnlockEMB { Function code }
- MOV DX,Handle { Handle in DX }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL
- End; { XMS_UnlockEMB }
-
- Function XMS_EMBHandlesAvail; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGetHandleInfo { Function code }
- MOV DX,Handle
- CALL [XMSDriver]
- OR AX,AX
- JZ @@1
- MOV AL,BL { Save number of free handles }
- XOR BL,BL
- @@1:
- MOV [XMSResult],BL
- End; { XMS_EMBHandlesAvail }
-
- Function XMS_EMBLockCount; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGetHandleInfo
- MOV DX,Handle { Handle in DX }
- CALL [XMSDriver]
- OR AX,AX
- JZ @@1
- MOV AL,BH { Save lock count }
- XOR BL,BL
- @@1:
- MOV [XMSResult],BL
- End; { XMS_EMBLockCount }
-
- Function XMS_EMBSize; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XGetHandleInfo
- MOV DX,Handle
- CALL [XMSDriver]
- OR AX,AX
- JZ @@1
- MOV AX,DX { Save EMB size in K-bytes }
- XOR BL,BL
- @@1:
- MOV [XMSResult],BL
- End; { XMS_EMBSize }
-
- Function XMS_AllocUMB; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XRequestUMB { Function code }
- MOV DX,Size { Number of paragraphs we want }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- MOV AX,BX { Return segment of UMB in low-order word }
- { Actual block size in high-order word }
- XOR BL,BL
- @@1:
- MOV [XMSResult],BL
- End; { XMS_AllocUMB }
-
- Function XMS_FreeUMB; assembler;
- Asm
- MOV BL,xmsrNotInitd
- CMP [XMSInitd],True
- JNE @@1
- MOV AH,XReleaseUMB { Function code }
- MOV DX,Segment { Segment of UMB to release }
- CALL [XMSDriver] { Call the XMS driver }
- OR AX,AX
- JZ @@1
- XOR BL,BL
- @@1:
- MOV AL,BL
- MOV [XMSResult],BL
- End; { XMS_FreeUMB }
-
- Function XMS_GetErrorMsg;
- var S : ^String;
- Begin
- New(S);
- case ErrorCode of
- xmsrNotInitd: S^ := 'XMS driver not initialized';
- xmsrBadFunction: S^ := 'Function not implemented';
- xmsrVDiskDetected: S^ := 'VDisk has detected';
- xmsrA20Error: S^ := 'An A20 error occurred';
- xmsrDriverError: S^ := 'A general driver error';
- xmsrUnrecError: S^ := 'Unrecoverable driver error';
- xmsrNoHMA: S^ := 'HMA does not exist';
- xmsrHMAInUse: S^ := 'HMA is already in use';
- xmsrHMAMinError: S^ := 'HMAMIN parameter is too large';
- xmsrHMANotAlloc: S^ := 'HMA is not allocated';
- xmsrA20Enabled: S^ := 'A20 line still enabled';
- xmsrNoMoreMem: S^ := 'All extended memory is allocated';
- xmsrNoMoreHandles: S^ := 'All available XMS handles are allocated';
- xmsrBadHandle: S^ := 'Invalid block handle';
- xmsrBadSourceH: S^ := 'Block source handle is invalid';
- xmsrBadSourceO: S^ := 'Block source offset is invalid';
- xmsrBadDestH: S^ := 'Block destination handle is invalid';
- xmsrBadDestO: S^ := 'Block destination offset is invalid';
- xmsrBadLength: S^ := 'Block length is invalid';
- xmsrBadOverlap: S^ := 'Move operation has an invalid overlap';
- xmsrParityError: S^ := 'Parity error';
- xmsrBlkNotLocked: S^ := 'Block is not locked';
- xmsrBlkLocked: S^ := 'Block is locked';
- xmsrBlkLCOverflow: S^ := 'Block lock count overflowed';
- xmsrLockFailed: S^ := 'Lock failed';
- xmsrSmallerUMB: S^ := 'Too large UMB requested';
- xmsrNoUMB: S^ := 'No UMB''s are available';
- xmsrBadUMBSegment: S^ := 'UMB segment number is invalid';
- else S^ := 'Unknown error'
- end;
- XMS_GetErrorMsg := S^;
- Dispose(S)
- End; { XMS_GetErrorMsg }
-
- Begin
- { Initialize global variables }
- XMSInitd := False;
- XMSResult := xmsrOk
- End. { XMSLib }
-
- { ***** XMSDEMO.PAS ***** }
-
- Program XMSLibDemo;
- { Copyright (c) 1994 by Andrew Eigus Fido Net: 2:5100/33 }
- { XMS Interface V2.02 for Turbo Pascal version 7.0 demonstration program }
-
- (*
- Tested on IBM 486 SX 33Mhz with 4MB RAM with the following configuration:
- 1) HIMEM.SYS (MS-DOS 6.2 XMS memory manager)
- 2) HIMEM.SYS (MS-DOS 6.2 XMS memory manager)
- EMM386.EXE (MS-DOS 6.2 EMS memory manager)
-
- If any inpredictable errors occur in your system while running this demo,
- please be so kind to inform me:
-
- AndRew's BBS Phone: 003-712-559777 (Riga, Latvia) 24h 2400bps
- Voice Phone: 003-712-553218
- Fido Net: 2:5100/20.12
- *)
-
- {X+}{$R-}
-
- uses XMSLib;
-
- type
- TMsg = array[1..14] of Char;
-
- TUMBAllocRec = record
- Size : word;
- SegAddr : word
- end;
-
- const
- Message1 : TMsg = 'First message ';
- Message2 : TMsg = 'Second message';
-
- YesNo : array[boolean] of string[3] = ('No', 'Yes');
- A20State : array[boolean] of string[8] = ('Disabled', 'Enabled');
-
- var
- Version, Memory, Handle, BlockLength : word;
- Locks, FreeHandles : byte;
- HMAAvailable : boolean;
- Address : pointer;
- UMB : longint;
-
- Function Hex(Num : longint; Places : byte) : string;
- const HexTab : array[0..15] of Char = '0123456789ABCDEF';
- var
- HS : string[8];
- Digit : byte;
- Begin
- HS[0] := Chr(Places);
- for Digit := Places downto 1 do
- begin
- HS[Digit] := HexTab[Num and $0000000F];
- Num := Num shr 4
- end;
- Hex := HS
- End; { Hex }
-
- Function Check(Result : byte; Func : string) : byte;
- Begin
- if Result <> xmsrOk then
- WriteLn(Func, ' returned ',
- Hex(Result, 2), 'h (', Result, '): ', XMS_GetErrorMsg(Result));
- Check := Result
- End; { Check }
-
- Procedure ShowA20State;
- var State : boolean;
- Begin
- State := XMS_QueryA20;
- if Check(XMSResult, 'XMS_QueryA20') = xmsrOk then
- WriteLn('A20 state: ', A20State[State])
- End; { ShowA20State }
-
- Procedure Wait4Return;
- Begin
- WriteLn;
- WriteLn('Press ENTER to continue');
- ReadLn
- end; { Wait4Return }
-
-
- Begin
- WriteLn('XMS Library V2.02 Demonstration program by Andrew Eigus'#10);
- if XMS_Setup then
- begin
-
- Version := XMS_GetVersion(XMS);
- if Check(XMSResult, 'XMS_GetVersion(XMS)') = xmsrOk then
- WriteLn('XMS version ', Hi(Version), '.', Lo(Version), ' present');
- Version := XMS_GetVersion(XMM);
- if Check(XMSResult, 'XMS_GetVersion(XMM)') = xmsrOk then
- WriteLn('XMM version ', Hi(Version), '.', Lo(Version), ' detected');
- HMAAvailable := XMS_HMAAvail;
- if Check(XMSResult, 'XMS_HMAAvail') = xmsrOk then
- WriteLn('HMA Available: ', YesNo[HMAAvailable]);
-
- WriteLn;
- Memory := XMS_MemAvail;
- if Check(XMSResult, 'XMS_MemAvail') = xmsrOk then
- WriteLn('Free XMS memory available: ', Memory, ' KB')
- else
- if XMSResult = xmsrNoMoreMem then Halt(xmsrNoMoreMem);
- Memory := XMS_MaxAvail;
- if Check(XMSResult, 'XMS_MaxAvail') = xmsrOk then
- WriteLn('Largest XMS memory block: ', Memory, ' KB');
-
- WriteLn;
- if HMAAvailable then
- if Check(XMS_AllocHMA($FFFF), 'XMS_AllocHMA') = xmsrOk then
- begin
- WriteLn('HMA: Block allocated');
- if Check(XMS_FreeHMA, 'XMS_FreeHMA') = xmsrOk then
- WriteLn('HMA: Block released')
- end;
-
- Wait4Return;
-
- WriteLn('XMS data transfer test'#10);
- WriteLn('Message1: ', Message1);
- WriteLn('Message2: ', Message2);
-
- Handle := XMS_AllocEMB(1);
- if Check(XMSResult, 'XMS_AllocEMB') = xmsrOk then
- begin
- WriteLn('1 KB EMB allocated. Handle number: ', Hex(Handle, 4), 'h');
- { Now copy our little Message1 to extended memory }
- if Check(XMS_MoveToEMB(Handle, Message1, SizeOf(TMsg)),
- 'XMS_MoveToEMB') = xmsrOk then WriteLn('Transfer to XMS: OK');
- { Now copy it back to the second string }
- if Check(XMS_MoveFromEMB(Handle, Message2, SizeOf(TMsg)),
- 'XMS_MoveFromEMB') = xmsrOk then WriteLn('Transfer from XMS: OK');
- WriteLn('Message1: ', Message1);
- WriteLn('Message2: ', Message2);
- WriteLn;
- if Check(XMS_ReallocEMB(Handle, 2),
- 'XMS_ReallocEMB') = xmsrOk then
- WriteLn('EMB reallocated. New size: 2 KB');
- WriteLn;
- Address := XMS_LockEMB(Handle);
- if Check(XMSResult, 'XMS_LockEMB') = xmsrOk then
- WriteLn('EMB locked at linear memory address ',
- Hex(Longint(Address), 8), 'h');
-
- WriteLn;
- FreeHandles := XMS_EMBHandlesAvail(Handle);
- if Check(XMSResult, 'XMS_EMBHandlesAvail') = xmsrOk then
- WriteLn('EMB Handles available: ', FreeHandles);
- Locks := XMS_EMBLockCount(Handle);
- if Check(XMSResult, 'XMS_EMBLockCount') = xmsrOk then
- WriteLn('EMB Lock count: ', Locks);
- BlockLength := XMS_EMBSize(Handle);
- if Check(XMSResult, 'XMS_EMBSize') = xmsrOk then
- WriteLn('EMB Length: ', BlockLength, ' KB');
-
- WriteLn;
- if Check(XMS_UnlockEMB(Handle), 'XMS_UnlockEMB') = xmsrOk then
- WriteLn('EMB unlocked');
-
- WriteLn;
- if Check(XMS_FreeEMB(Handle), 'XMS_FreeEMB') = xmsrOk then
- WriteLn('EMB released');
-
- Wait4Return
- end;
-
- UMB := XMS_AllocUMB($FFFF);
- if Check(XMSResult, 'XMS_AllocUMB') = xmsrOk then
- begin
- WriteLn('UMB allocated at segment base ',
- Hex(TUMBAllocRec(UMB).SegAddr, 4), 'h');
- WriteLn('Actual size: ', TUMBAllocRec(UMB).Size, ' paragraphs'#10);
- if Check(XMS_FreeUMB(TUMBAllocRec(UMB).SegAddr),
- 'XMS_FreeUMB') = xmsrOk then WriteLn('UMB released')
- end;
- end else WriteLn('XMS not present.')
- End.